home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Menus / filesetsMenu.tcl < prev    next >
Encoding:
Text File  |  1998-12-22  |  47.8 KB  |  1,651 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "filesetsMenu.tcl"
  6.  #                    created: 20/7/96 {6:22:25 pm} 
  7.  #                   last update: 22/12/1998 {10:52:42 pm} 
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #==============================================================================
  15.  # Alpha calls two fileset-related routines, 'getCurrFileSet', and 
  16.  # 'getFileSetNames'. Alpha will also attempt to set the variable 'currFileSet'
  17.  # on occasion, but this isn't critical.
  18.  #==============================================================================
  19.  # 
  20.  #  modified by  rev reason
  21.  #  -------- --- --- -----------
  22.  #  24/3/96  VMD 1.0 update of Pete's original to allow mode-specific filesets
  23.  #  27/3/96  VMD 1.1 added hierarchial filesets, and checks for unique menus
  24.  #  13/6/96  VMD 1.2 memory efficiency improvements with 'fileSets' array
  25.  #  10/3/97  VMD 1.3 added 'procedural' fsets, including 'Open Windows'
  26.  #  6/4/97   VMD 1.31 various fixes incorporated - thanks!
  27.  #  11/7/97  VMD 1.4 added cache for the fileset menu, improved wc proc.
  28.  #  15/7/97  VMD 1.41 better handling of out-of-date filesets, and dir opening
  29.  #  15/7/97  VMD 1.42 placed cache in separate file.
  30.  #  21/7/97  VMD 1.43 added glob patterns to ignore for directory filesets
  31.  #  22/7/97  VMD 1.5 more sophisticated menu caching.  No more long rebuilds!
  32.  #  10/9/97  VMD 1.6 simplified some stuff for new Alpha-Tcl
  33.  #  7/12/97  VMD 1.6.1 makes use of winNumDirty flag
  34.  #  12/1/98  VMD 1.6.2 removes special treatment of *recent*
  35.  # ###################################################################
  36.  ##
  37.  
  38. ## 
  39.  # These procedures    are    now    more robust    and    general-purpose. Basic new
  40.  # features    are: 
  41.  # 
  42.  #       *  user configurable    menu
  43.  #       *  unique-menu names    are    ensured, so    there can be no    clashes
  44.  #       *  new fileset types    ('tex' and 'fromHierarchy')
  45.  #       *  new utility functions    ('stuff', 'wordCount',...)
  46.  #       *  filesets need    not    appear in the menu;    in fact    they can be
  47.  #          anywhere you like
  48.  #          
  49.  # Known Bugs:
  50.  # 
  51.  #  You cannot have a hierarchial fileset which contains more than
  52.  #  one folder with the same name as the fileset, including the
  53.  #  base folder.  This is very hard to fix, and the easy workaround
  54.  #  is just to rename the fileset in some minor way.
  55.  ##
  56.  
  57. alpha::menu filesetMenu 1.7.1 global "•131" {
  58. } {filesetMenu} {} uninstall {this-file} help {[editMark [file join $HOME Help "Alpha Manual"] "File Sets" -r]}
  59.  
  60. proc filesetMenu {} {}
  61.  
  62. # Build some filesets on the fly.
  63. set gfileSets(Help) [file join $HOME Help *]
  64. set gfileSets(System) [list [file join $HOME Tcl SystemCode *.tcl] 2]
  65. set gfileSets(Menus) [list [file join $HOME Tcl Menus *.tcl] 2]
  66. set gfileSets(Modes) [list [file join $HOME Tcl Modes *.tcl] 2]
  67. set "gfileSets(Open Windows)" procFilesetOpenWindows 
  68. set "gfileSets(Top Window's Folder)" procFilesetDirTopWin 
  69.  
  70. # Declare their types
  71. set gfileSetsType(Help) "fromDirectory"
  72. set gfileSetsType(System) "fromHierarchy"
  73. set gfileSetsType(Modes) "fromHierarchy"
  74. set gfileSetsType(Menus) "fromHierarchy"
  75. set "gfileSetsType(Open Windows)" "procedural"
  76. set "gfileSetsType(Top Window's Folder)" "procedural"
  77.  
  78. # Procs for procedural filesets
  79. proc procFilesetOpenWindows {} { return [winNames -f] }
  80. proc procFilesetDirTopWin {} { 
  81.     if {[set w [win::Current]] == ""} {
  82.     return ""
  83.     } else {
  84.     return [glob -t TEXT -nocomplain [file join [file dirname [win::Current]] *]]
  85.     }
  86. }
  87.  
  88. if {![file exists [file join $HOME Tcl Packages]]} { file mkdir [file join $HOME Tcl Packages] }
  89. set gfileSets(Packages) [list [file join $HOME Tcl Packages *.tcl] 2]
  90. set gfileSetsType(Packages) "fromHierarchy"
  91.  
  92. # Default curr fileset is the first one. 
  93. newPref var currFileSet "System" global changeFileSet gfileSets array
  94.  
  95. # ◊◊◊◊ Variables and flags ◊◊◊◊ #
  96.  
  97. #################################################
  98. # Any of these can be over-ridden by the stored #
  99. # definitions in defs.tcl, arrdefs.tcl          #
  100. #################################################
  101.  
  102. ## 
  103.  # We don't    show the 'help'    fileset, since it's    under the MacOS
  104.  # AppleGuide menu.     Also we could perhaps yank    tex-filesets away
  105.  # into    their own menu,    in which case the tex-system could add to
  106.  # this    variable as    it went    along.
  107.  ##
  108. lunion filesetsNotInMenu "Help" "Open Windows" "Top Window's Folder"
  109.  
  110. ## 
  111.  # A type is a means of    generating a fileset given its 
  112.  # description in the variable 'gfileSets(name)':
  113.  ##
  114. lunion fileSetsTypes "list" "glob" "fromHierarchy" "procedural"
  115.  
  116. ## 
  117.  # A menu type is a    means of prompting the user    and    
  118.  # characterising the interface    to a type, even
  119.  # though the actual storage may be    very simple
  120.  # (a list in most cases).
  121.  ##
  122. set fileSetsTypesThing(fromDirectory) "glob"
  123. set fileSetsTypesThing(fromHierarchy) "fromHierarchy"
  124. set fileSetsTypesThing(think) "list"
  125. set fileSetsTypesThing(codewarrior) "list"
  126. set fileSetsTypesThing(ftp) "list"
  127. set fileSetsTypesThing(fromOpenWindows) "list"
  128. set fileSetsTypesThing(procedural) "procedural"
  129.  
  130. ## 
  131.  # To add a    new    fileset    type, you need to define the following:
  132.  #       set fileSetsTypesThing(myType) "list"
  133.  #       proc    myTypeCreateFileset    {} {}
  134.  #       proc    myTypeFilesetUpdate    {name} {}
  135.  # 
  136.  # For more    complex    types (e.g.    the    tex-type), define as follows:
  137.  #       set fileSetsTypesThing(myType) "myType"
  138.  #       proc    myTypeCreateFileset    {} {}
  139.  #       proc    myTypeFilesetSelected {    fset menu item }    {}
  140.  #       proc    myTypeFilesetUpdate    { name } {}
  141.  #       proc    myTypeListFilesInFileset { name    } {}
  142.  #       proc    myTypeMakeFileSetSubMenu { name    } {}
  143.  # 
  144.  # These procedures    will all be    called automatically under the
  145.  # correct circumstances.  The purposes of these are as follows:
  146.  #
  147.  #   'create'   -- query the user for name etc. and create
  148.  #   'update'   -- given the information in 'gfileSets', recalculate
  149.  #                   the member files.
  150.  #   'selected' -- a member was selected in a menu.
  151.  #   'list'     -- given info in all except 'fileSets', return list
  152.  #                 of files to be stored in that variable.
  153.  #   'submenu'  -- generate the sub-menu
  154.  # 
  155.  # Your    code may wish to call 'isWindowInFileset ?win? ?type?' to
  156.  # check if    a given    (current by    default) window    is in a    fileset    of
  157.  # a given type.
  158.  ##
  159.  
  160. ## 
  161.  # -------------------------------------------------------------------------
  162.  #     
  163.  #    "filesetSortOrder" --
  164.  #    
  165.  #       The structure of    this variable dictates how the fileset
  166.  #       menu    is structured:
  167.  #           
  168.  #           '{pattern p}' 
  169.  #               lists all filesets which    match 'p'
  170.  #           '-' 
  171.  #               adds    a separator    line
  172.  #           '{list of types}' 
  173.  #               lists all filesets of those types.
  174.  #           '{submenu name sub-order-list}' 
  175.  #               adds    a submenu with name    'name' and recursively
  176.  #               adds    filesets to    that submenu as    given by the 
  177.  #               sub-order.
  178.  #               
  179.  #       Leading,    trailing and double    separators are automatically
  180.  #       removed.
  181.  #     
  182.  # -------------------------------------------------------------------------
  183.  ##
  184. ensureset filesetSortOrder { {pattern *System} {pattern Packages} \
  185.     {pattern Menus} {pattern Modes} {pattern Preferences} \
  186.     - {tex} - {pattern *.cc} {submenu Headers {pattern *.h}} \
  187.     - {fromDirectory think codewarrior ftp \
  188.     fromOpenWindows fromHierarchy} * } 
  189.  
  190. set    "filesetUtils(browseFileset…)" [list * browseFileset]
  191. set    "filesetUtils(renameFileset…)" [list * renameFileset]
  192. set    "filesetUtils(openEntireFileset…)" [list * openEntireFileset]
  193. set    "filesetUtils(filesetToAlpha…)" [list * filesetToAlpha]
  194. set    "filesetUtils(closeEntireFileset…)" [list * closeEntireFileset]
  195. set    "filesetUtils(replaceInFileset…)" [list * replaceInFileset]
  196. set    "filesetUtils(stuffFileset…)" [list * stuffFileset]
  197. set    "filesetUtils(wordCount)" [list * wordCountFileset]
  198. set    "filesetUtils(wordCountFast)" [list * wordCountFilesetFast]
  199. set    "filesetUtils(openFilesetFolder…)" [list * openFilesetFolder]
  200.  
  201.  
  202. ## 
  203.  # The meaning of these    flags is as    follows:
  204.  #       sortFilesetItems    -- 
  205.  #           a type can have the option of being unsorted    (e.g. tex-filesets)
  206.  #       indentFilesetItems --
  207.  #           visual formatting may be    of relevance to    some types
  208.  #       sortFilesetsByType -- 
  209.  #           use the variable    'filesetSortOrder' to determine    the
  210.  #           visual structure    of the fileset menu
  211.  #       autoAdjustFileset --
  212.  #           when    a file is selected from    the    menu, do we    try    and    
  213.  #           keep    'currFileSet' accurate?
  214.  #       includeNonTextFiles --
  215.  #           filesets may include non-text files.  Alpha will tell the
  216.  #           finder to open these if they are selected.
  217.  ##        
  218. newPref flag sortFilesetItems 0 "fileset"
  219. newPref flag indentFilesetItems 0 "fileset"
  220. newPref flag sortFilesetsByType 0 "fileset" rebuildSomeFilesetMenu
  221. newPref flag autoAdjustFileset 1 "fileset"
  222. newPref flag includeNonTextFiles 0 "fileset" rebuildSomeFilesetMenu
  223.  
  224. # To add a new fileset type, all we have to do is this:
  225. # set fileSetsTypesThing(tex) "tex"
  226. # lappend fileSetsTypes "tex"
  227. # If you create new types just add lines like that
  228.  
  229. #===========================================================================
  230. # The support routines.
  231. #===========================================================================
  232. # Called from Alpha to get list of files for current file set.
  233. proc getCurrFileSet {} {
  234.     global currFileSet
  235.     return [getFileSet $currFileSet]
  236. }
  237.  
  238. # Called from Alpha to get names. The first name returned is taken to 
  239. # be the current fileset.
  240. proc getFileSetNames {} {
  241.     global gfileSets currFileSet gDirScan
  242.     set perm [list $currFileSet]
  243.     set temp {}
  244.     set ind [lsearch [array names gfileSets] $currFileSet]
  245.     if {$ind < 0} {set ind 0}
  246.     foreach n [lsort -ignore [array names gfileSets]] {
  247.     if {[info exists gDirScan($n)]} {
  248.         lappend temp $n
  249.     } else {
  250.         lappend perm $n
  251.     }
  252.     }
  253.     if {[llength $temp]} {
  254.     return [concat $perm - $temp]
  255.     } else {
  256.     return $perm
  257.     }
  258. }
  259.  
  260. #================================================================================
  261. # Edit a file from a fileset via list dialogs (no mousing around).
  262. #================================================================================
  263. proc editFile {} {
  264.     global currFileSet modifiedVars gfileSetsType file::separator
  265.     
  266.     set fset [pickFileset "" {Fileset?} "list"]
  267.     set currFileSet $fset
  268.     lappend modifiedVars currFileSet
  269.     
  270.     set ff [getFilesInSet $fset]
  271.     foreach f $ff {
  272.     lappend disp [file tail $f]
  273.     }
  274.     foreach res [listpick -l -p {File?} [lsort -ignore $disp]]  {
  275.     set ind [lsearch $ff "\*${file::separator}$res"]
  276.     if {$gfileSetsType($fset) == "ftp"} {
  277.         ftpFilesetOpen $fset [lindex $ff $ind]
  278.     } else {
  279.         catch {generalOpenFileitem [lindex $ff $ind]}
  280.     }
  281.     }
  282. }
  283.  
  284. # We only return TEXT files, since we don't want Alpha
  285. # manipulating the data fork of non-text files.
  286. proc getFileSet {fset} {
  287.     global filesetmodeVars
  288.     if $filesetmodeVars(includeNonTextFiles) {
  289.     set fnames ""
  290.     foreach f [getFilesInSet $fset] {
  291.         if [file isfile $f] {
  292.         getFileInfo $f a
  293.         if {$a(type) == "TEXT"} {
  294.             lappend fnames $f
  295.         }
  296.         }
  297.     }
  298.     return $fnames
  299.     } else {
  300.     return [getFilesInSet $fset]
  301.     }
  302. }
  303.  
  304. proc browseFileset {{fset ""}} {
  305.     global tileLeft tileTop tileWidth errorHeight
  306.     
  307.     set fset [pickFileset $fset {Fileset?}]
  308.     
  309.     foreach f [getFilesInSet $fset] {
  310.     append text "\t[file tail $f]\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"
  311.     }
  312.     new -n "* FileSet '$fset' Browser *" -g $tileLeft $tileTop 200 $errorHeight -m Brws
  313.     insertText "(<cr> to go to file)\r-----\r$text\r"
  314.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  315.     winReadOnly
  316.     message ""
  317. }    
  318.  
  319. # ◊◊◊◊ Basic procedures ◊◊◊◊ #
  320.  
  321. namespace eval fileset {}
  322.  
  323. # under development
  324. proc newFileset {} {
  325.     global currFileSet gfileSetsType fileSetsTypesThing modifiedArrayElements
  326.     foreach type  {
  327.     lappend dialog -n $type 
  328.     }
  329.     set res [dialog::paged -pageproc fileset::page [lsort -ignore [array names fileSetsTypesThing]]]
  330.  
  331.     if {![string length $name]} return
  332.     
  333.     lappend modifiedArrayElements [list $name gfileSetsType]
  334.     set gfileSetsType($name) $type
  335.     
  336.     set currFileSet $name
  337.     filesetsJustChanged $type $name
  338.     return $currFileSet
  339. }
  340.  
  341. proc fileset::page {fset x y} {
  342.     return [fileset::create$fset $x $y]
  343. }
  344.  
  345. proc newFileset {{type ""}} {
  346.     global currFileSet gfileSetsType fileSetsTypesThing modifiedArrayElements
  347.     if {$type == ""} {
  348.     set type [dialog::optionMenu "New fileset type?"  [lsort -ignore [array names fileSetsTypesThing]] "fromDirectory"]
  349.     }
  350.     set name [eval ${type}CreateFileset]
  351.  
  352.     if ![string length $name] return
  353.     
  354.     lappend modifiedArrayElements [list $name gfileSetsType]
  355.     set gfileSetsType($name) $type
  356.     
  357.     set currFileSet $name
  358.     filesetsJustChanged $type $name
  359.     return $currFileSet
  360. }
  361.  
  362.  
  363. ## 
  364.  # -------------------------------------------------------------------------
  365.  # 
  366.  # "filesetsJustChanged" --
  367.  # 
  368.  #  If we've added, deleted, modified a fileset, we call this procedure.
  369.  #  In most cases we must rebuild everything (due to limitations in Alpha),
  370.  #  but for 'procedural' filesets, we can just do the utilities menu.
  371.  # -------------------------------------------------------------------------
  372.  ##
  373. proc filesetsJustChanged {type name} {
  374.     if {$type == "procedural"} {
  375.     global filesetsNotInMenu modifiedVars
  376.     if {[lsearch $filesetsNotInMenu $name] == -1} {
  377.         lappend filesetsNotInMenu $name
  378.         lappend modifiedVars filesetsNotInMenu
  379.     }
  380.     rebuildFilesetUtilsMenu
  381.     } else {
  382.     rebuildAllFilesets 1
  383.     }
  384. }
  385.  
  386. proc printFileset { {fset ""}} {
  387.     set fset [pickFileset $fset "Print which Fileset?"]
  388.     foreach f [getFilesInSet $fset] {
  389.     print $f
  390.     }
  391. }
  392.  
  393.  
  394. proc deleteFileset { {fset ""} {yes 0} } {
  395.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  396.     global filesetMenu subMenuFilesetInfo subMenuInfo filesetsNotInMenu
  397.     global modifiedVars modifiedArrayElements
  398.     
  399.     set fset [pickFileset $fset "Delete which Fileset?"]
  400.     if {$currFileSet == $fset} {catch {set currFileSet System}}
  401.     
  402.     if {$yes || [dialog::yesno "Delete fileset \"$fset\"?"]} {
  403.     catch {unset "fileSetsExtra($fset)"}
  404.     catch {unset "gfileSetsType($fset)"}
  405.     catch {unset "fileSets($fset)"}
  406.     catch {unset "gfileSets($fset)"}
  407.     
  408.     lappend modifiedArrayElements \
  409.       [list $fset gfileSetsType] [list $fset fileSetsExtra] \
  410.       [list $fset gfileSets]
  411.     
  412.     set err [catch {removeFilesetFromMenu $fset}]
  413.     
  414.     if {[set l [lsearch  $filesetsNotInMenu $fset]] != -1} {
  415.         set filesetsNotInMenu [lreplace $filesetsNotInMenu $l $l]
  416.         lappend modifiedVars filesetsNotInMenu
  417.         deleteMenuItem -m choose $fset
  418.         deleteMenuItem -m hideFileset $fset
  419.         return
  420.     }
  421.     if $err {
  422.         # it's on a submenu or somewhere else so we just have
  423.         # to do the lot!
  424.         if !$yes { rebuildAllFilesets 1 }
  425.     } else {
  426.         deleteMenuItem -m choose $fset
  427.         deleteMenuItem -m hideFileset $fset
  428.     }
  429.     }
  430. }
  431.  
  432. proc removeFilesetFromMenu {fset} {
  433.     global subMenuFilesetInfo subMenuInfo
  434.     # find its menu:
  435.     if [info exists subMenuFilesetInfo($fset)] {
  436.     foreach m $subMenuFilesetInfo($fset) {
  437.         # remove info about it's name
  438.         if [info exists subMenuInfo($m)] {
  439.         unset subMenuInfo($m)
  440.         cache::add filesetMenuCache "eval" [list unset subMenuInfo($m)]
  441.         }
  442.     }
  443.     set base [lindex $subMenuFilesetInfo($fset) 0]
  444.     unset subMenuFilesetInfo($fset)
  445.     cache::add filesetMenuCache "eval" [list unset subMenuFilesetInfo($fset)]
  446.     cache::snippetRemove $fset
  447.     # this will fail if it's on a submenu or if it isn't a menu at all
  448.     deleteMenuItem -m $filesetMenu $base
  449.     cache::add filesetMenuCache "eval" [list deleteMenuItem -m $filesetMenu $base]
  450.     } else {
  451.     # I think I do nothing
  452.     }
  453.     
  454. }
  455.  
  456. ## 
  457.  # -------------------------------------------------------------------------
  458.  #     
  459.  #    "pickFileset" --
  460.  #    
  461.  #     Ask the user for a/several    filesets.  If 'fset' is    set, we    just
  462.  #     return    that (this avoids 'if {$fset !=    ""}    { set fset [pick...] }
  463.  #     constructs    everywhere).  A    prompt can be given, and a dialog type
  464.  #     (either a listpick, a pop-up menu,    or a listpick with multiple
  465.  #     selection), and extra items can be    added to the list if desired.
  466.  # -------------------------------------------------------------------------
  467.  ##
  468. proc pickFileset { fset {prompt Fileset?} {type "list"} {extras {}} } {
  469.     global gfileSets currFileSet
  470.     if { $fset != "" } { return $fset }
  471.     switch $type {
  472.     "popup" {
  473.         set fset [eval [list prompt $prompt \
  474.           $currFileSet "FileSet:"] [lsort -ignore [array names gfileSets]]]
  475.         if ![info exists gfileSets($fset)] { error "No such fileset" }
  476.         return $fset
  477.     }
  478.     "list" {
  479.         return [listpick -p $prompt -L $currFileSet \
  480.           [lsort -ignore [concat $extras [array names gfileSets]]]]
  481.     }
  482.     "multilist" {
  483.         return [listpick -p $prompt -l -L $currFileSet \
  484.           [lsort -ignore [concat $extras [array names gfileSets]]]]
  485.     }        
  486.     }
  487. }
  488.  
  489. proc renameFileset {} {
  490.     global fileSets gfileSets currFileSet fileSetsExtra gfileSetsType
  491.     global fileSetsTypesThing modifiedArrayElements
  492.     
  493.     set fset [pickFileset "" {Fileset to rename?}]
  494.     
  495.     set name [getline "Rename to:" $fset]
  496.     if {![string length $name] || $name == $fset} return
  497.     
  498.     set gfileSets($name) $gfileSets($fset)
  499.     set gfileSetsType($name) $gfileSetsType($fset)
  500.     catch {set fileSets($name) $fileSets($fset)}
  501.     catch {set fileSetsExtra($name) $fileSetsExtra($fset)}
  502.     
  503.     deleteFileset $fset 1
  504.     
  505.     lappend modifiedArrayElements [list $name gfileSets]
  506.     lappend modifiedArrayElements [list $name gfileSetsType]
  507.     lappend modifiedArrayElements [list $name fileSetsExtra]
  508.     
  509.     filesetsJustChanged $gfileSetsType($name) $name
  510.     set currFileSet $name
  511. }
  512.  
  513. proc updateCurrentFileset {} {
  514.     global currFileSet
  515.     updateAFileset $currFileSet
  516. }
  517.  
  518. proc updateAFileset { {fset ""} } {
  519.     set fset [pickFileset $fset]
  520.     
  521.     global gfileSetsType fileSets subMenuFilesetInfo subMenuInfo
  522.     
  523.     set type $gfileSetsType($fset)
  524.     catch {eval [list "${type}FilesetUpdate" $fset] }
  525.     set m [makeFileSetAndMenu $fset 1]
  526.     # we could rebuild the menu with this: but we don't
  527.     cache::add filesetMenuCache "eval" $m
  528.     if {[info exists subMenuFilesetInfo($fset)]} {
  529.     # if the fileset already has a base menu, use that:
  530.     foreach n $subMenuFilesetInfo($fset) {
  531.         cache::add filesetMenuCache "variable" subMenuInfo($n)
  532.     }
  533.     cache::add filesetMenuCache "variable" subMenuFilesetInfo($n)
  534.     }
  535.     if [info exists fileSets($fset)] {
  536.     cache::add filesetMenuCache "variable" fileSets($fset)
  537.     }
  538.     eval $m
  539.     callFilesetUpdateProcedures $fset
  540.     message "Done"
  541. }
  542.  
  543. proc callFilesetUpdateProcedures { {fset ""} } {
  544.     global filesetUpdateProcs gfileSetsType
  545.     if { $fset == "" } {
  546.     set types [array names filesetUpdateProcs]
  547.     } else {
  548.     set types $gfileSetsType($fset)
  549.     }
  550.     
  551.     foreach l $types {
  552.     if [info exists filesetUpdateProcs($l)] {
  553.         foreach proc $filesetUpdateProcs($l) {
  554.         uplevel \#0 $proc
  555.         }
  556.     }
  557.     }
  558.     
  559. }
  560.  
  561. # ◊◊◊◊ Creation of basic fileset types ◊◊◊◊ #
  562.  
  563. proc proceduralCreateFileset {} {
  564.     global gfileSets gfileSetsType filesetsNotInMenu modifiedArrayElements
  565.     set name [getline "Name for this fileset…"]
  566.     if {![string length $name]} return
  567.     set gfileSetsType($name) "procedural"
  568.     set p procFileset[join $name ""]
  569.     set gfileSets($name) $p
  570.     addUserLine "\# procedure to list files in fileset '$name' on the fly"
  571.     addUserLine "proc $p \{\} \{"
  572.     addUserLine "\t"
  573.     addUserLine "\}"
  574.     lappend modifiedArrayElements [list $name gfileSets]
  575.     lappend modifiedArrayElements [list $name gfileSetsType]
  576.     if {[dialog::yesno "I've added a template for the procedure to your 'prefs.tcl'. Do you want to edit it now?"]} {
  577.     global::editPrefsFile
  578.     goto [maxPos]
  579.     beep
  580.     message "Make sure you 'load' the new procedure."
  581.     }
  582.     lappend filesetsNotInMenu $name
  583.     return $name
  584. }
  585.  
  586. # under development
  587. proc fileset::createfromDirectory {x y} {
  588.     eval lappend dial \
  589.       [dialog::edit "New fileset name:" $x y 20] \
  590.       [dialog::edit "New fileset dir:" $x y 20] \
  591.       [dialog::edit "File pattern:" $x y 20]
  592. }
  593.  
  594. proc fromDirectoryCreateFileset {} {
  595.     global gfileSets gfileSetsType fileSetsExtra
  596.     
  597.     set name [getFilesetDirectoryAndPattern]
  598.     if {![string length $name]} return
  599.     set filePatIgnore [getline "List of file patterns to ignore:" ""]
  600.     if {$filePatIgnore != ""} {
  601.     set fileSetsExtra($name) $filePatIgnore
  602.     }
  603.     
  604.     set gfileSetsType($name) "fromDirectory"
  605.     
  606.     if {[dialog::yesno "Save new fileset?"]} {
  607.     global modifiedArrayElements
  608.     lappend modifiedArrayElements [list $name gfileSets]
  609.     lappend modifiedArrayElements [list $name gfileSetsType]
  610.     if [info exists fileSetsExtra($name)] {
  611.         lappend modifiedArrayElements [list $name fileSetsExtra]
  612.     }
  613.     }
  614.     return $name
  615. }
  616.  
  617. proc getFilesetDirectoryAndPattern {} {
  618.     global gfileSets fileSetsExtra
  619.     set name [getline "New fileset name:" ""]
  620.     if {![string length $name]} return
  621.     
  622.     set dir [get_directory -p "New fileset dir:"]
  623.     if {![string length $dir]} return
  624.     
  625.     set filePat [getline "File pattern:" "*"]
  626.     if {![string length $filePat]} return
  627.     
  628.     set gfileSets($name) [file join $dir $filePat]
  629.     return $name
  630. }
  631.  
  632. proc fromDirectoryFilesetUpdate {name} {
  633.     # done on the fly so no need to update
  634.     #global fileSets gfileSets
  635.     #set fileSets($name) [glob -t TEXT -nocomplain "$gfileSets($name)"]
  636. }
  637.  
  638. proc fromHierarchyCreateFileset {} {
  639.     global gfileSets gfileSetsType    
  640.     
  641.     set name [getFilesetDirectoryAndPattern]
  642.     if ![string length $name] return
  643.     
  644.     set gfileSetsType($name) "fromHierarchy"
  645.     set depth [listpick -p "Depth of hierarchy?" -L 3 {1 2 3 4 5 6 7}]
  646.     if { $depth == "" } {set depth 3}
  647.     
  648.     set gfileSets($name) [list $gfileSets($name) $depth]
  649.     
  650.     if {[dialog::yesno "Save new fileset?"]} {
  651.     global modifiedArrayElements
  652.     lappend modifiedArrayElements [list $name gfileSets] \
  653.       [list $name gfileSetsType]
  654.     }
  655.     return $name
  656. }
  657.  
  658. proc fromHierarchyFilesetUpdate {name} {
  659.     fromHierarchyMakeFileSet $name 0
  660. }
  661.  
  662. proc fromHierarchyMakeFileSetAndMenu {name andMenu} {
  663.     global filesetTemp fileSets gfileSets
  664.     set dir [file dirname [lindex $gfileSets($name) 0]]
  665.     set patt [file tail [lindex $gfileSets($name) 0]]
  666.     set depth [lindex $gfileSets($name) 1]
  667.     # we make the menu as a string, but can bin it if we like
  668.     set menu [menu::buildHierarchy [list $dir] $name filesetProc filesetTemp $patt $depth $name]
  669.     
  670.     # we need to construct the list of items
  671.     set fileSets($name) {}
  672.     if [info exists filesetTemp] {
  673.     foreach n [array names filesetTemp] {
  674.         lappend fileSets($name) $filesetTemp($n)
  675.     }
  676.     unset filesetTemp
  677.     }
  678.     return $menu
  679. }
  680.  
  681. proc fromHierarchyFilesetSelected {fset menu item} {
  682.     global gfileSets
  683.     set dir [file dirname [lindex $gfileSets($fset) 0]]
  684.     set ff [getFilesInSet $fset]
  685.     if { $fset == $menu } {
  686.     # it's top level
  687.     if {[set match [lsearch $ff [file join ${dir} $item]]] >= 0} {
  688.         autoUpdateFileset $fset
  689.         generalOpenFileitem [lindex $ff $match]
  690.         return
  691.     }
  692.     }
  693.     # the following two are slightly cumbersome, but give us the best
  694.     # chance of finding the correct file given any ambiguity (which can
  695.     # certainly arise if file and directory names clash excessively).
  696.     if {[set match [lsearch $ff [file join ${dir} ${menu} $item]]] >= 0} {
  697.     autoUpdateFileset $fset
  698.     generalOpenFileitem [lindex $ff $match]
  699.     return
  700.     }
  701.     if {[set match [lsearch $ff [file join ${dir} * ${menu} $item]]] >= 0} {
  702.     autoUpdateFileset $fset
  703.     generalOpenFileitem [lindex $ff $match]
  704.     return
  705.     }
  706.     error "Weird! Couldn't find it."
  707. }
  708.  
  709.  
  710. proc codewarriorCreateTagFile {} { return [alphaCreateTagFile] }
  711. proc thinkCreateTagFile {} { return [alphaCreateTagFile] }
  712.  
  713. proc fromOpenWindowsCreateFileset {} {
  714.     global gfileSets modifiedArrayElements
  715.     
  716.     set name [prompt "Create fileset containing current windows under what name?" "OpenWins"]
  717.     
  718.     set gfileSets($name) [winNames -f]
  719.     lappend modifiedArrayElements [list $name gfileSets]
  720.     
  721.     return $name
  722. }
  723.  
  724.  
  725. # ◊◊◊◊ Menu procedures ◊◊◊◊ #
  726.  
  727. ## 
  728.  # Global procedures to    deal with the fact that    Alpha can only have    one
  729.  # menu    with each given    name.  This    is only    a problem in dealing with
  730.  # user-defined    menus such as fileset menus, tex-package menus,    ...
  731.  ##
  732.  
  733. ## 
  734.  # -------------------------------------------------------------------------
  735.  #     
  736.  #    "makeFilesetSubMenu" --
  737.  #    
  738.  #     If    desired    this is    the    only procedure you need    use    ---    it returns
  739.  #     a menu    creation string, taking    account    of the unique name requirement
  740.  #     and will make sure    your procedure 'proc' is called    with the real
  741.  #     menu name!
  742.  # -------------------------------------------------------------------------
  743.  ##
  744. proc makeFilesetSubMenu {fset name proc args} {
  745.     if { [string length $proc] > 1 } {
  746.     return [concat {Menu -m -n} [list [registerFilesetMenuName $fset $name $proc]] -p subMenuProc $args]
  747.     } else {
  748.     return [concat {Menu -m -n} [list [registerFilesetMenuName $fset $name]] $args]
  749.     }
  750. }
  751.  
  752. ## 
  753.  # -------------------------------------------------------------------------
  754.  #     
  755.  #    "registerFilesetMenuName" --
  756.  #    
  757.  #     Call to ensure    unique fileset submenu names.  We just add spaces
  758.  #     as    appropriate    and    keep track of everything for you!  Filesets
  759.  #     which have    multiple menus _must_ register the main    menu first.
  760.  # -------------------------------------------------------------------------
  761.  ##
  762. proc registerFilesetMenuName {fset name {proc ""}} {
  763.     global subMenuInfo subMenuFilesetInfo
  764.     if { $fset == $name && [info exists subMenuFilesetInfo($fset)] } {
  765.     # if the fileset already has a base menu, use that:
  766.     foreach n $subMenuFilesetInfo($fset) {
  767.         if { [string trimright $n] == $fset } {
  768.         set base $n
  769.         } 
  770.         unset subMenuInfo($n)
  771.     }
  772.     unset subMenuFilesetInfo($fset)
  773.     }
  774.     set original $name                    
  775.     if [info exists base] {
  776.     set name $base
  777.     } else {
  778.     # I add at least one space to _all_ hierarchical submenus now.
  779.     # This is so I won't clash with any current or future modes
  780.     # which should never normally add spaces themselves.
  781.     append name " "
  782.     while { [info exists subMenuInfo($name)] } {
  783.         append name " "
  784.     }        
  785.     }
  786.     
  787.     set subMenuInfo($name) [list "$fset" "$original" "$proc"]
  788.     # build list of a fileset's menus
  789.     lappend subMenuFilesetInfo($fset) "$name"
  790.     
  791.     return $name
  792. }
  793.  
  794.  
  795. proc realMenuName {name} {
  796.     global subMenuInfo
  797.     return [lindex $subMenuInfo($name) 1]
  798. }
  799.  
  800. ## 
  801.  # -------------------------------------------------------------------------
  802.  #     
  803.  #    "subMenuProc" --
  804.  #    
  805.  #     This procedure    is implicitly used to deal with    ensuring unique
  806.  #     sub-menu names.  It calls the procedure you asked for,    with
  807.  #     the name of the menu you think    you're using.
  808.  # -------------------------------------------------------------------------
  809.  ##
  810. proc subMenuProc {menu item} {
  811.     global subMenuInfo
  812.     set l $subMenuInfo($menu)
  813.     set realProc [lindex $l 2]
  814.     if {[info commands $realProc] == ""} {catch "$realProc"}
  815.     # try to call the proc with three arguments (fileset is 1st)
  816.     if {[llength [info args $realProc]] == 2} {
  817.     $realProc [lindex $l 1] "$item"
  818.     } else {
  819.     $realProc [lindex $l 0] [lindex $l 1] "$item"
  820.     }
  821. }
  822.  
  823.  
  824. proc filesetMenuProc {menu item} {
  825.     switch $item {
  826.     "Edit File" {
  827.         editFile
  828.         return
  829.     } 
  830.     "Help" {
  831.         global HOME
  832.         editMark [file join $HOME Help "Alpha Manual"] "File Sets" -r
  833.         return
  834.     }
  835.     }
  836. }
  837.  
  838. ## 
  839.  # -------------------------------------------------------------------------
  840.  #     
  841.  #    "filesetProc" --
  842.  #    
  843.  #     Must be called    by 'subMenuProc'
  844.  # -------------------------------------------------------------------------
  845.  ##
  846. proc filesetProc {fset menu item} {
  847.     global gfileSetsType 
  848.     if {$fset != ""} {set m $fset} else { set m $menu}
  849.     switch $gfileSetsType($m) {
  850.     "fromDirectory" -
  851.     "think" -
  852.     "codewarrior" -
  853.     "fromOpenWindows" {
  854.         if [catch {filesetBasicOpen $m $item}] {
  855.         if {[dialog::yesno "That file wasn't found.  That fileset is probably out of date; do you want to rebuild it?"]} {
  856.             updateAFileset $fset
  857.         }
  858.         }
  859.     }
  860.     "ftp" { ftpFilesetOpen $m $item }
  861.     "default" {
  862.         # try a type-specific method first
  863.         set proc $gfileSetsType($m)FilesetSelected
  864.         if {[info commands $proc] == "" && (![auto_load $proc])} {
  865.         # if that failed then just hope it's an ordinary list
  866.         if ![catch {filesetBasicOpen $m $item}] {return}
  867.         } else {
  868.         if {[llength [info args $proc]] == 2} {
  869.             if ![catch {eval [list $proc $menu $item]}] {return}
  870.         } else {
  871.             if ![catch {eval [list $proc $fset $menu $item]}] {return}
  872.         }
  873.         }
  874.         
  875.         if {[dialog::yesno "That file wasn't found.  That fileset is probably out of date; do you want to rebuild it?"]} {
  876.         updateAFileset $fset
  877.         }
  878.     }
  879.     }
  880. }
  881.  
  882. proc filesetBasicOpen { menu item } {
  883.     global file::separator
  884.     if {[set match [lsearch [getFilesInSet $menu] *${file::separator}$item]] >= 0} {
  885.     autoUpdateFileset $menu
  886.     generalOpenFileitem [lindex [getFilesInSet $menu] $match]
  887.     return
  888.     }
  889.     error "file not found"
  890. }
  891.  
  892. ## 
  893.  # -------------------------------------------------------------------------
  894.  # 
  895.  # "generalOpenFileitem" --
  896.  # 
  897.  #  Works around an alpha bug with aliases.
  898.  # -------------------------------------------------------------------------
  899.  ##
  900. proc generalOpenFileitem {file} {
  901.     if [file isfile $file] {
  902.     file::openAny $file
  903.     } else {
  904.     # is it an alias?
  905.     if {[file type $file] == "unknown"} {
  906.         getFileInfo $file a
  907.         # is it a folder?
  908.         if {$a(type) != "fdrp"} {
  909.         file::openAny $file
  910.         return
  911.         }
  912.     }
  913.     global file::separator
  914.     findFile "${file}${file::separator}"
  915.     }
  916. }
  917.  
  918. proc registerUpdateProcedure { type proc } {
  919.     global filesetUpdateProcs
  920.     lappend filesetUpdateProcs($type) $proc
  921. }
  922.  
  923. proc filesetUtilsProc { menu item } {
  924.     global filesetUtils gfileSetsType currFileSet
  925.     if [info exists filesetUtils($item)] {
  926.     # it's a utility
  927.     set utilDesc $filesetUtils($item)
  928.     set allowedTypes [lindex $utilDesc 0]
  929.     if [string match $allowedTypes $gfileSetsType($currFileSet)] {
  930.         return [eval [lindex $utilDesc 1]]
  931.     } else {
  932.         beep
  933.         message "That utility can't be applied to the current file-set."
  934.         return
  935.     }
  936.     } else {
  937.     $item
  938.     }
  939. }
  940. proc getFilesInSet {fset} {
  941.     global gfileSets fileSetsTypesThing gfileSetsType
  942.     switch $fileSetsTypesThing($gfileSetsType($fset)) {
  943.     "list" {
  944.         return $gfileSets($fset)
  945.     }
  946.     "glob" {
  947.         global filesetmodeVars fileSetsExtra
  948.         if $filesetmodeVars(includeNonTextFiles) {
  949.         set l [glob -nocomplain "$gfileSets($fset)"]
  950.         if [info exists fileSetsExtra($fset)] {
  951.             foreach pat $fileSetsExtra($fset) {
  952.             foreach f [glob -nocomplain [file join [file dirname "$gfileSets($fset)"] $pat]] {
  953.                 set i [lsearch $l $f]
  954.                 set l [lreplace $l $i $i]
  955.             }
  956.             }
  957.         }
  958.         return $l
  959.         } else {
  960.         set l [glob -t TEXT -nocomplain "$gfileSets($fset)"]
  961.         if [info exists fileSetsExtra($fset)] {
  962.             foreach pat $fileSetsExtra($fset) {
  963.             foreach f [glob -t TEXT -nocomplain [file join [file dirname "$gfileSets($fset)"] $pat]] {
  964.                 set i [lsearch $l $f]
  965.                 set l [lreplace $l $i $i]
  966.             }
  967.             }
  968.         }
  969.         return $l
  970.         }
  971.     }
  972.     "procedural" {
  973.         return [$gfileSets($fset)]
  974.     }        
  975.     "default" {
  976.         global fileSets
  977.         if ![info exists fileSets($fset)] {
  978.         # This means the menu was cached, but this info wasn't.
  979.         # We calculate the set, and menu, and cache them
  980.         # (since they're at the end of the file, they over-ride
  981.         # what's there.
  982.         
  983.         # we rebuild the menu too
  984.         eval [makeFileSetAndMenu $fset 1]
  985.         cache::add filesetMenuCache "variable" fileSets($fset)
  986.         }
  987.         return $fileSets($fset)
  988.     }
  989.     }
  990. }
  991.  
  992. proc makeFileSetAndMenu {name andMenu {use_cache 0}} {
  993.     if {$use_cache} {
  994.     set m [cache::snippetRead $name]
  995.     if {$m != ""} {return $m}
  996.     }
  997.     global gfileSetsType fileSetsTypesThing
  998.     message "Building ${name}..."
  999.     set type $gfileSetsType($name)
  1000.     switch -- $fileSetsTypesThing($type) {
  1001.     "list" -
  1002.     "glob" {
  1003.         if $andMenu {
  1004.         set menu {}
  1005.         foreach m [getFilesInSet $name] {
  1006.             lappend menu "[file tail $m]&"
  1007.         }
  1008.         set m [makeFilesetSubMenu $name $name filesetProc [lsort -increasing $menu]]
  1009.         } else {
  1010.         return
  1011.         }
  1012.     }
  1013.     "procedural" {
  1014.         return
  1015.     }
  1016.     "default" {
  1017.         set m [${type}MakeFileSetAndMenu $name $andMenu]
  1018.         
  1019.     }
  1020.     }     
  1021.     cache::snippetWrite $name $m
  1022.     return $m
  1023. }
  1024.  
  1025. proc filesetsSorted { order usedvar {use_cache 0}} {
  1026.     upvar $usedvar used
  1027.     global filesetmodeVars gfileSets gfileSetsType
  1028.     set sets {}
  1029.     foreach item $order {
  1030.     switch -- [lindex $item 0] {
  1031.         "-" { 
  1032.         # add divider
  1033.         lappend sets "(-" 
  1034.         continue
  1035.         } 
  1036.         "*" {
  1037.         # add all the rest
  1038.         set subset {}
  1039.         foreach s [array names gfileSets] {
  1040.             if ![lcontains used $s]  {
  1041.             lappend subset $s
  1042.             lappend used $s
  1043.             }
  1044.         }
  1045.         foreach f [lsort $subset] {
  1046.             lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1047.         }
  1048.         } 
  1049.         "pattern" {
  1050.         # find all which match a given pattern
  1051.         set patt [lindex $item 1]
  1052.         set subset {}
  1053.         foreach s [array names gfileSets] {
  1054.             if ![lcontains used $s]  {
  1055.             if [string match $patt $s] {
  1056.                 lappend subset $s
  1057.                 lappend used $s
  1058.             }
  1059.             }
  1060.         }
  1061.         foreach f [lsort $subset] {
  1062.             lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1063.         }
  1064.         
  1065.         }
  1066.         "submenu" {
  1067.         # add a submenu with name following and sub-order
  1068.         set name [lindex $item 1]
  1069.         set suborder [lrange $item 2 end]              
  1070.         # we make kind of a pretend fileset here.
  1071.         set subsets [filesetsSorted $suborder used]
  1072.         if { $subsets != "" } {
  1073.             lappend sets [makeFilesetSubMenu $name $name filesetProc $subsets]
  1074.         }
  1075.         }
  1076.         "default" {        
  1077.         set subset {} 
  1078.         foreach s [array names gfileSets] {
  1079.             if {[lcontains item $gfileSetsType($s)] && ![lcontains used $s]}  {
  1080.             lappend subset $s
  1081.             lappend used $s
  1082.             }
  1083.         }
  1084.         foreach f [lsort $subset] {
  1085.             lappend sets [makeFileSetAndMenu $f 1 $use_cache]
  1086.         }
  1087.         }
  1088.     }
  1089.     
  1090.     }
  1091.     # remove multiple and leading, trailing '-' in case there were gaps
  1092.     regsub -all {\(-( \(-)+} $sets {(-} sets
  1093.     while { [lindex $sets 0] == "(-" } { set sets [lrange $sets 1 end] }
  1094.     set l [expr [llength $sets] -1]
  1095.     if { [lindex $sets $l] == "(-" } { set sets [lrange $sets 0 [incr l -1]] }
  1096.     
  1097.     return $sets
  1098. }
  1099.  
  1100. ## 
  1101.  # -------------------------------------------------------------------------
  1102.  # 
  1103.  # "rebuildFilesetMenu" --
  1104.  # 
  1105.  #  Reads the fileset menu from the cache if it exists.  This speeds up
  1106.  #  start-up by quite a bit.
  1107.  # -------------------------------------------------------------------------
  1108.  ##
  1109. proc rebuildFilesetMenu {} { 
  1110.     message "Building filesets..."
  1111.     if [cache::exists filesetMenuCache] {
  1112.     global subMenuFilesetInfo subMenuInfo fileSets
  1113.     cache::read filesetMenuCache 
  1114.     rebuildFilesetUtilsMenu
  1115.     callFilesetUpdateProcedures
  1116.     } else {
  1117.     rebuildAllFilesets 1
  1118.     }
  1119.     
  1120. }
  1121.     
  1122. ## 
  1123.  # -------------------------------------------------------------------------
  1124.  #     
  1125.  #    "zapAndBuildFilesets" --
  1126.  #    
  1127.  #     This does a complete rebuild of all information.  The problem is that
  1128.  #     the names of menus    may    actually change    (spaces    added/deleted).    This
  1129.  #     is    not    a problem for the fileset menu,    but    is a problem for any
  1130.  #     filesets which    have been added    to other menus,    since they won't know
  1131.  #     that they need    to be rebuilt.
  1132.  # -------------------------------------------------------------------------
  1133.  ##
  1134. proc zapAndBuildFilesets {} {
  1135.     global subMenuInfo subMenuFilesetInfo
  1136.     unset subMenuInfo
  1137.     unset subMenuFilesetInfo
  1138.     rebuildAllFilesets
  1139. }
  1140.  
  1141. proc rebuildAllFilesets { {use_cache 0} } {
  1142.     global gfileSets filesetMenu  filesetSortOrder 
  1143.     global filesetmodeVars filesetsNotInMenu fileSets
  1144.     message "Rebuilding filesets menu…"
  1145.     
  1146.     if {$filesetmodeVars(sortFilesetsByType)} {
  1147.     # just make file-sets for those we don't want in the menu
  1148.     if {!$use_cache} {
  1149.         foreach f $filesetsNotInMenu {
  1150.         makeFileSetAndMenu $f 0 
  1151.         }
  1152.     }
  1153.     set used $filesetsNotInMenu
  1154.     set sets [filesetsSorted $filesetSortOrder used $use_cache]
  1155.     } else {
  1156.     foreach f [lsort [array names gfileSets]] {
  1157.         set doMenu [expr {![lcontains filesetsNotInMenu $f]}]
  1158.         set menu [makeFileSetAndMenu $f $doMenu $use_cache]
  1159.         if {$doMenu && [llength $menu]} {
  1160.         lappend sets $menu
  1161.         }        
  1162.     }            
  1163.     }
  1164.     
  1165.     regsub -all {[-][nm]} $sets "" names
  1166.     foreach nn $names {
  1167.     lappend names_ [string trimright [lindex $names 1]]
  1168.     }
  1169.     set names $names_
  1170.     
  1171.     # cache the fileset menu
  1172.     set m [list Menu -m -n $filesetMenu -p filesetMenuProc \
  1173.       [concat {{/'Edit File…} {Menu -n Utilities {}}} "Help" \
  1174.       "(-" $sets]]
  1175.     cache::create filesetMenuCache 
  1176.     cache::add filesetMenuCache "eval" $m [list insertMenu $filesetMenu]
  1177.     global subMenuFilesetInfo subMenuInfo
  1178.     cache::add filesetMenuCache "variable" subMenuFilesetInfo subMenuInfo fileSets
  1179.     eval $m
  1180.     
  1181.     rebuildFilesetUtilsMenu
  1182.     callFilesetUpdateProcedures
  1183.     
  1184.     message ""
  1185. }
  1186.  
  1187. ## 
  1188.  # -------------------------------------------------------------------------
  1189.  #     
  1190.  #    "rebuildSomeFilesetMenu" --
  1191.  #    
  1192.  #     If    given '*' rebuild the entire menu, else    rebuild    only those types
  1193.  #     given.     This is generally useful to avoid excessive rebuilding    when
  1194.  #     flags are adjusted
  1195.  # -------------------------------------------------------------------------
  1196.  ##
  1197. proc rebuildSomeFilesetMenu {args} {
  1198.     rebuildAllFilesets        
  1199. }
  1200.  
  1201. proc rebuildFilesetUtilsMenu {} {
  1202.     global gfileSets filesetUtils 
  1203.     
  1204.     Menu -n "Utilities" -p filesetUtilsProc [concat \
  1205.       "newFileset…" \
  1206.       "deleteFileset…" \
  1207.       "printFileset…" \
  1208.       "<S<EupdateAFileset…" \
  1209.       "<SupdateCurrentFileset" \
  1210.       "<S<EzapAndBuildFilesets" \
  1211.       "<SrebuildAllFilesets" \
  1212.       [list [menu::makeFlagMenu choose list currFileSet]] \
  1213.       [list [list Menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]]] \
  1214.       [list [menu::makeFlagMenu filesetFlags array filesetmodeVars]] \
  1215.       "(-" \
  1216.       "/T<I<OfindTag" \
  1217.       "createTagFile" \
  1218.       "(-" \
  1219.       [lsort [array names filesetUtils]] \
  1220.       ]
  1221.     
  1222.     filesetUtilsMarksTicks
  1223. }
  1224.  
  1225. proc rebuildSimpleFilesetMenus {} {
  1226.     global gfileSets fileSetsTypesThing
  1227.     eval [menu::makeFlagMenu choose list currFileSet]
  1228.     Menu -n hideFileset -m -p hideShowFileset [lsort [array names gfileSets]]
  1229.     filesetUtilsMarksTicks
  1230. }
  1231.  
  1232. proc hideShowFileset {menu item} {
  1233.     global filesetsNotInMenu filesetMenu
  1234.     if {[lcontains filesetsNotInMenu $item]} {
  1235.     global gfileSetsType
  1236.     if {$gfileSetsType($item) == "procedural"} {
  1237.         alertnote "Sorry, procedural filesets are completely dynamic and cannot appear in menus."
  1238.         return
  1239.     }
  1240.     set idx [lsearch $filesetsNotInMenu $item]
  1241.     set filesetsNotInMenu [lreplace $filesetsNotInMenu $idx $idx]        
  1242.     markMenuItem -m hideFileset $item off
  1243.     # would be better if we could just insert it
  1244.     rebuildAllFilesets 1
  1245.     } else {
  1246.     lappend filesetsNotInMenu $item
  1247.     markMenuItem -m hideFileset $item on
  1248.     if [catch {removeFilesetFromMenu $item}] {
  1249.         rebuildAllFilesets 1
  1250.     }
  1251.     }
  1252.     global modifiedVars
  1253.     lappend modifiedVars filesetsNotInMenu
  1254. }
  1255.  
  1256. proc filesetUtilsMarksTicks {} {
  1257.     global filesetsNotInMenu
  1258.     
  1259.     foreach name $filesetsNotInMenu {
  1260.     markMenuItem -m hideFileset $name on
  1261.     }
  1262.     
  1263. }
  1264.  
  1265.  
  1266. # Called in response to user changing filesets from the fileset menu.
  1267. proc changeFileSet {item} {
  1268.     global currFileSet tagFile
  1269.     # Bring in the tags file for this fileset
  1270.     set fname [tagFileName]
  1271.     if {[file exists $fname]} {
  1272.     if {[dialog::yesno "Use tag file from folder \"$dir\" ?"]} {
  1273.         set tagFile $fname
  1274.     }
  1275.     }
  1276. }
  1277.  
  1278. proc autoUpdateFileset { name } {
  1279.     global currFileSet filesetmodeVars modifiedVars
  1280.     if $filesetmodeVars(autoAdjustFileset) {
  1281.     set currFileSet $name
  1282.     lunion modifiedVars currFileSet
  1283.     }
  1284. }
  1285.  
  1286.  
  1287. # ◊◊◊◊ Utility procs ◊◊◊◊ #
  1288.  
  1289. proc isWindowInFileset { {win "" } {type ""} } {
  1290.     if {$win == ""} { set win [win::Current] }
  1291.     global currFileSet gfileSets gfileSetsType
  1292.     
  1293.     if { $type == "" } {
  1294.     set okSets [array names gfileSets]
  1295.     } else {
  1296.     set okSets {}
  1297.     foreach s [array names gfileSets] {
  1298.         if { $gfileSetsType($s) == $type } {
  1299.         lappend okSets $s
  1300.         }
  1301.     }
  1302.     }
  1303.     
  1304.     if {[array exists gfileSets]} {
  1305.     if {[lsearch -exact $okSets $currFileSet] != -1 } {
  1306.         # check current fileset
  1307.         if {[lsearch -exact [getFilesInSet $currFileSet] $win] != -1 } {
  1308.         # we're set, it's in this fileset
  1309.         return  $currFileSet
  1310.         }
  1311.     }
  1312.     
  1313.     # check other fileset
  1314.     foreach fset $okSets {
  1315.         if {[lsearch -exact [getFilesInSet $fset] $win] != -1 } {
  1316.         # we're set, it's in this project
  1317.         return  $fset
  1318.         }
  1319.     }   
  1320.     }
  1321.     return ""
  1322.     
  1323. }
  1324.  
  1325.  
  1326.  
  1327. ## 
  1328.  # -------------------------------------------------------------------------
  1329.  #     
  1330.  #    "iterateFileset" --
  1331.  # 
  1332.  #       Utility procedure to    iterate    over all files in a    project,
  1333.  #       calling some    predefined function    '$fn' for each member of
  1334.  #       project '$proj'.    The    results    of such    a call are passed to
  1335.  #       '$resfn'    if given. Finally "done" is    passed to 'resfn'.
  1336.  #     
  1337.  # -------------------------------------------------------------------------
  1338.  ##
  1339. proc iterateFileset { proj fn { resfn \# } } {
  1340.     global gfileSets gfileSetsType
  1341.     eval $resfn "first"
  1342.     
  1343.     set check [expr {![catch {$gfileSetsType($proj)IterateCheck check}]}]
  1344.     
  1345.     foreach ff [getFileSet $proj] {
  1346.     if { $check && [$gfileSetsType($proj)IterateCheck $proj $ff] } {
  1347.         continue
  1348.     }
  1349.     set res [eval $fn [list $ff]]
  1350.     eval $resfn [list $res]
  1351.     }
  1352.     
  1353.     if $check {
  1354.     catch {$gfileSetsType($proj)IterateCheck done}
  1355.     }
  1356.     
  1357.     eval $resfn "done"
  1358.     
  1359. }
  1360.  
  1361. # ◊◊◊◊ Tags ◊◊◊◊ #
  1362.  
  1363. if {![string length [info commands alphaFindTag]]} {
  1364.     rename findTag alphaFindTag
  1365.     rename createTagFile alphaCreateTagFile
  1366. }
  1367.  
  1368. proc tagFileName {} {
  1369.     global gfileSets currFileSet 
  1370.     return [file join [file dirname [car $gfileSets($currFileSet)]] "[join ${currFileSet}]TAGS"]
  1371. }
  1372.  
  1373. proc findTag {} {
  1374.     global gfileSetsType currFileSet
  1375.     # try a type-specific method first
  1376.     if {[catch {$gfileSetsType($currFileSet)FindTag}]} {
  1377.     alphaFindTag
  1378.     }
  1379. }
  1380.  
  1381. proc createTagFile {} {
  1382.     global gfileSetsType currFileSet tagFile modifiedVars
  1383.     set tagFile [tagFileName]
  1384.     lappend modifiedVars tagFile
  1385.     
  1386.     # try a type-specific method first
  1387.     if {[catch {$gfileSetsType($currFileSet)CreateTagFile}]} {
  1388.     alphaCreateTagFile
  1389.     }
  1390. }
  1391.  
  1392. # ◊◊◊◊ Utils ◊◊◊◊ #
  1393.  
  1394.     
  1395. proc dirtyFileset { fset } {
  1396.     foreach f [getFilesInSet $fset] {
  1397.     if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { return 1 }
  1398.     }
  1399.     return 0
  1400. }
  1401.  
  1402. proc saveEntireFileset { fset } {
  1403.     foreach f [getFilesInSet $fset] {
  1404.     if { ![catch {getWinInfo -w $f arr}] && $arr(dirty)} { 
  1405.         bringToFront $f
  1406.         save 
  1407.     }
  1408.     }
  1409. }
  1410.  
  1411. proc closeEntireFileset { {fset ""} } {
  1412.     set fset [pickFileset $fset "Close which fileset?" "popup"]
  1413.     
  1414.     foreach f [getFilesInSet $fset] {
  1415.     if ![catch {getWinInfo -w $f arr}] {
  1416.         bringToFront $f
  1417.         killWindow
  1418.     }
  1419.     }
  1420. }
  1421.  
  1422. proc fileToAlpha {f} {
  1423.     if {[file isfile $f] && ([getFileType $f] == "TEXT") && ([getFileSig $f] != "ALFA")} {
  1424.     message "Converting $f"
  1425.     setFileInfo $f creator ALFA
  1426.     }    
  1427. }
  1428.  
  1429. proc filesetToAlpha {} {
  1430.     set fset [pickFileset "" {Convert all files from which fileset?} "popup"]
  1431.     iterateFileset $fset fileToAlpha
  1432. }
  1433.  
  1434. ## 
  1435.  # -------------------------------------------------------------------------
  1436.  # 
  1437.  # "replaceInFileset" --
  1438.  # 
  1439.  #  Quotes things correctly so searches work, and adds a check on
  1440.  #  whether there are any windows.
  1441.  # -------------------------------------------------------------------------
  1442.  ##
  1443. proc replaceInFileset {} {
  1444.     global gfileSets win::NumDirty
  1445.     set how [dialog::optionMenu "Search type:" \
  1446.       [list "Textual replace" "Case-independent textual replace" \
  1447.       "Regexp replace" "Case-independent regexp replace"] "" 1]
  1448.     set from [prompt "Search string:" [searchString]]
  1449.     searchString $from
  1450.     if {$how < 2} {set from [quote::Regfind $from]}
  1451.     
  1452.     set to [prompt "Replace string:" [replaceString]]
  1453.     replaceString $to
  1454.     if {$how < 2} {set to [quote::Regsub $to]}
  1455.     if [catch {regsub $from "$from" $to dummy} err] {
  1456.     alertnote "Regexp compilation problems: $err"
  1457.     return
  1458.     }
  1459.     set fsets [pickFileset "" "Which filesets?" "multilist"]
  1460.     
  1461.     if {${win::NumDirty}} {
  1462.     if {[buttonAlert "Save all windows?" "Yes" "Cancel"] != "Yes"} return
  1463.     saveAll
  1464.     }
  1465.     
  1466.     set cid [scancontext create]
  1467.     set changes 0
  1468.     if {$how & 1} {
  1469.     set case "-nocase"
  1470.     } else {
  1471.     set case "--"
  1472.     }
  1473.     
  1474.     scanmatch $case $cid $from {set matches($f) 1 ;incr changes}
  1475.     foreach fset $fsets {
  1476.     foreach f [getFileSet $fset] {
  1477.         if {![catch {set fid [open $f]}]} {
  1478.         message "Looking at '[file tail $f]'"
  1479.         scanfile $cid $fid
  1480.         close $fid
  1481.         }
  1482.     }
  1483.     }
  1484.     
  1485.     scancontext delete $cid
  1486.     
  1487.     foreach f [array names matches] {
  1488.     message "Modifying ${f}…"
  1489.     set cid [open $f "r"]
  1490.     if {[regsub -all $case $from [read $cid] $to out]} {
  1491.         set ocid [open $f "w+"]
  1492.         puts -nonewline $ocid $out
  1493.         close $ocid
  1494.     }
  1495.     close $cid
  1496.     }
  1497.     
  1498.     revertTheseFiles [array names matches]
  1499.     message "Replaced $changes instances"
  1500. }
  1501.  
  1502. proc openEntireFileset {} {
  1503.     set fset [pickFileset "" "Open which fileset?" "popup"]
  1504.     
  1505.     # we use our iterator in case there's something special to do
  1506.     iterateFileset $fset "edit -c -w"
  1507. }
  1508.  
  1509. proc openFilesetFolder {} {
  1510.     global gfileSets
  1511.     set fset [pickFileset "" "Open which fileset's folder?" "popup"]
  1512.     if {[llength [list $gfileSets($fset)]] == 1 && [file isdirectory [set dir [file dirname $gfileSets($fset)]]]} {
  1513.     openFolder $dir
  1514.     } else {
  1515.     alertnote "Fileset not connected to a folder."
  1516.     }
  1517. }
  1518.  
  1519. proc stuffFileset {} {
  1520.     global gfileSetsType gfileSets
  1521.     set fset [pickFileset "" "Which fileset shall I stuff?" "popup"]
  1522.     if [string length $fset] {
  1523.     if { $gfileSetsType($fset) == "fromDirectory" && \
  1524.       [dialog::yesno "Stuff entire directory?"]} {
  1525.         app::launchFore DStf
  1526.         regexp {ZZ(.)ZZ} [file join ZZ ZZ] "" separator
  1527.         sendOpenEvent reply 'DStf' "[file dirname $gfileSets($fset)]${separator}"
  1528.     } else {            
  1529.         app::launchFore DStf
  1530.         eval sendOpenEvents 'DStf' [getFilesInSet $fset]
  1531.     }        
  1532.     sendQuitEvent 'DStf'
  1533.     }
  1534. }
  1535.  
  1536. proc filesetRememberOpenClose { file } {
  1537.     global fileset_openorclosed
  1538.     set fileset_openorclosed [list "$file" [lsearch -exact [winNames -f] $file]]
  1539. }
  1540.  
  1541. proc filesetRevertOpenClose { file } {
  1542.     global fileset_openorclosed
  1543.     if { [lindex $fileset_openorclosed 0] == "$file" } {
  1544.     if { [lindex $fileset_openorclosed 1] < 0 } {
  1545.         killWindow
  1546.     }
  1547.     }    
  1548.     catch {unset fileset_openorclosed}
  1549. }
  1550.  
  1551. proc wordCountFileset {} {
  1552.     global currFileSet
  1553.     iterateFileset $currFileSet wordCountProc filesetUtilWordCount
  1554. }
  1555.  
  1556. proc wordCountFilesetFast {} {
  1557.     global currFileSet
  1558.     iterateFileset $currFileSet wc filesetUtilWordCount
  1559. }
  1560.  
  1561. proc filesetUtilWordCount {count} {
  1562.     global fs_ccount fs_wcount fs_lcount
  1563.     switch $count {
  1564.     "first" {
  1565.         set fs_ccount 0
  1566.         set fs_wcount 0
  1567.         set fs_lcount 0
  1568.     }       
  1569.     "done" {
  1570.         alertnote "There were $fs_ccount lines, $fs_wcount words and $fs_lcount chars"
  1571.         unset fs_ccount fs_wcount fs_lcount
  1572.     }
  1573.     default {
  1574.         incr fs_ccount [lindex $count 2]
  1575.         incr fs_wcount [lindex $count 1]
  1576.         incr fs_lcount [lindex $count 0]
  1577.     }
  1578.     }
  1579. }
  1580.  
  1581.  
  1582. ## 
  1583.  # -------------------------------------------------------------------------
  1584.  # 
  1585.  # "wordCountProc" --
  1586.  # 
  1587.  #  Completely new proc which does the same as the old one
  1588.  #  without opening lots of windows.
  1589.  #  *Very* memory comsuming for large files, though.
  1590.  #  But I think the old one was equally memeory consuming.
  1591.  #  
  1592.  #  Ok, this is not exactly a bug fix. It's a IMHO better option.
  1593.  #  
  1594.  # -------------------------------------------------------------------------
  1595.  ##
  1596.  
  1597. proc wordCountProc {file} {
  1598.     message "Counting [file tail $file]…"
  1599.     set fid [open $file r]
  1600.     set filecont [read $fid]
  1601.     close $fid
  1602.     if {[regexp {\n\r} $filecont]} {
  1603.     set newln "\n\r"
  1604.     } elseif {[regexp {\n} $filecont]} {
  1605.     set newln "\n"
  1606.     } else {
  1607.     set newln "\r"
  1608.     }
  1609.     set lines [expr [regsub -all $newln $filecont " " filecont] + 1]
  1610.     set chars [string length $filecont]
  1611.     regsub -all {[!=;.,\(\#\=\):\{\"\}]} $filecont " " filecont
  1612.     set words [llength $filecont]
  1613.     return "$chars $words $lines"
  1614. }
  1615.  
  1616.  
  1617. # ◊◊◊◊ From search dialog ◊◊◊◊ #
  1618.  
  1619. proc findNewFileset {} {
  1620.     return [newFileset]
  1621. }
  1622.  
  1623.  
  1624. proc findNewDirectory {} {
  1625.     global gfileSets currFileSet gfileSetsType gDirScan
  1626.     
  1627.     set dir [get_directory -p "Scan which folder?"]
  1628.     if {![string length $dir]} return
  1629.     
  1630.     set filePat {*}
  1631.     set name [file tail $dir]
  1632.     
  1633.     set gfileSets($name) [file join $dir $filePat]
  1634.     set gDirScan($name) 1
  1635.     set gfileSetsType($name) "fromDirectory"
  1636.     set currFileSet $name
  1637.     updateCurrentFileset
  1638.     return $name
  1639. }
  1640.  
  1641. # Should be last so all filesets make it in.
  1642. rebuildFilesetMenu
  1643.  
  1644.  
  1645.  
  1646.  
  1647.  
  1648.  
  1649.  
  1650.  
  1651.